module Instr ( 
    writeMemory, readMemory, getAddress, toOper,
    fromOper, alterPC, push, pull, branchIf, mkAddr,
    compare', pullPC, pushPC, alterStatus, setZN,
    hasVSub, hasVAdd, hasCSub, hasCAdd
) where

import CPUDefs

import Data.Word
import Data.Bits
import Control.Monad.Reader
import Data.STRef

--
-- This module contains various handy functions
-- used when dealing with instructions
-- Note that no implementation of instructions goes here
--

writeMemory :: Address -> Operand -> NES s ()
writeMemory addr op
    | addr < 0x2000 = mem >>= \m -> (low m) // (addr `mod` 0x800,op)
    | addr < 0x4000 = mem >>= \m -> (ppu m) // (0x2000 + addr `mod` 8,op)
    | otherwise     = mem >>= \m -> (high m) // (addr,op)
  where mem = asks fst >>= lift . readSTRef

readMemory :: Address -> NES s Operand
readMemory addr
    | addr <  0x2000 = mem >>= \m -> (low m) ! (addr `mod` 0x800)
    | addr <  0x4000 = mem >>= \m -> (ppu m) ! (0x2000 + addr `mod` 8) 
    | otherwise      = mem >>= \m -> (high m) ! addr
  where mem = asks fst >>= lift . readSTRef

-- Translate an address mode to an address
getAddress :: AddrMode -> NES s Address
getAddress mode = case mode of
    ZeroPage offset addr -> case offset of
        Just ix -> do
            inx <- getIndex ix 
            return $ transform $ addr + inx
        _       -> return $ transform addr
    Absolute offset addr -> case offset of
        Just ix -> getIndex ix >>= \inx -> return $ addr + (fromIntegral inx)
        _       -> return addr
    Indexed when op -> case when of
        Before -> do
            inx  <- gets xReg
            low  <- readMemory (transform $ op+inx)
            high <- readMemory (transform $ op+inx+1)
            return $! mkAddr low high
        _      -> do
            inx  <- gets yReg
            low  <- readMemory $ transform op
            high <- readMemory $ transform (op+1)
            return $ (mkAddr low high) + (fromIntegral inx)
    Relative op     -> gets pc >>= \pc -> return $ pc + (fromIntegral op)
    Indirect addr   -> do
        low  <- readMemory addr
        high <- readMemory (addr+1)
        return $ mkAddr low high
 where
    getIndex X = gets xReg
    getIndex Y = gets yReg

-- | Status to 8bit operand
toOper :: Status -> Operand
toOper status = foldl (\a b -> 2*a+b) 0
              . map (\s -> if (s status) then 1 else 0)
              $ [n, v, const False, b, d, i, z, c]

-- | Given Status and a Status flag return 1 if True, 0 if false.
getStatusVal :: Num m => Status -> (Status -> Bool) -> m
getStatusVal status f = if f status then 1 else 0

-- Alter the status of the CPU
alterStatus :: (Status -> Status) -> NES s ()
alterStatus f = modify $ \cpu -> cpu { status = f (status cpu) }

-- | 8bit operand to status record
fromOper :: Operand -> Status
fromOper oper = Status { 
    c = oper .&. 0x01 /= 0,
    z = oper .&. 0x02 /= 0,
    i = oper .&. 0x04 /= 0,
    d = oper .&. 0x08 /= 0,
    b = oper .&. 0x10 /= 0,
    v = oper .&. 0x40 /= 0,
    n = oper .&. 0x80 /= 0
    }

-- Handy functions to set Z and N flag
setZN :: Operand -> Status -> Status
setZN op stat = stat { z = op==0, n = op < 0 }

-- alter the PC
alterPC :: (Address -> Address) -> NES s ()
alterPC f = modify $ \cpu -> cpu { pc = f (pc cpu) }

-- | Push something on the stack
push :: Operand -> NES s ()
push op = do
    cpu <- get
    put $ cpu { sp = (sp cpu)-1 }
    writeMemory (baseSP + (fromIntegral $ sp cpu)) op

-- | Pull something from the stack
pull :: NES s Operand
pull = do
    modify $ \cpu -> cpu { sp = (sp cpu) + 1}
    cpu <- get
    readMemory $ baseSP + (fromIntegral $ sp cpu)

-- | Update CPU program counter if @b@ is satisfied and return if succeded.
branchIf :: (Status -> Bool) -> Address -> NES s Bool
branchIf b addr = do
    stat <- gets status
    if b stat
        then alterPC (const addr) >> return True
        else return False

-- build a 16-bit address from low and high components
mkAddr :: Operand -> Operand -> Address
mkAddr low high = ((transform high) `shift` 8) + (transform low)

-- cast an Int8 to a Word16 without promotion of sign
transform :: Operand -> Address
transform op = (fromIntegral op) .&. 0x00FF

-- checks if we have overflow in an addition
hasVAdd :: Operand -> Operand -> Operand -> Bool
hasVAdd op1 op2 res 
    | op1 >= 0 && op2 >= 0 && res < 0   = True
    | op1 < 0  && op2 < 0  && res >= 0  = True
    | otherwise                         = False

-- checks if we have overflow in a subtraction
hasVSub :: Operand -> Operand -> Operand -> Bool
hasVSub op1 op2 res
    | op1 >= 0 && op2 <  0 && res <  0 = True
    | op1 <  0 && op2 >= 0 && res >= 0 = True
    | otherwise                        = False

-- checks if we have carry in an addition
hasCAdd :: Operand -> Operand -> Operand -> Bool
hasCAdd op1 op2 res
    | op1 >= 0 && op2 < 0 && res >= 0 = True
    | op1 <  0 && op2 < 0             = True
    | otherwise                       = False

-- checks if we have carry in an subtraction
hasCSub :: Operand -> Operand -> Operand -> Bool
hasCSub op1 op2 res
    | op1 >= 0 && op2 >= 0 && res >= 0 = True
    | op1 <  0 && op2 <  0 && res >= 0 = True
    | op1 <  0 && op2 >= 0             = True
    | otherwise                        = False

-- CMP, CPY, CPX
compare' :: Operand -> Operand -> Status -> Status
compare' reg mval status = status {
                           c = reg >= mval,
                           z = reg == mval,
                           n = res < 0 }
                         where res = reg - mval

-- Pull the program counter from stack
pullPC :: NES s Address
pullPC = liftM2 mkAddr pull pull

-- Push the program counter on stack
pushPC :: NES s ()
pushPC = do
    pc <- gets pc
    push $ fromIntegral $ pc `shiftR` 8
    push $ fromIntegral $ pc

